home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
pstui100.zip
/
PTUIVCRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-03-12
|
27KB
|
1,091 lines
{
╔══════════════════╗
║ PTUI Virual ║
║ Screen Driver ║
║ Rev. 1.00 ║
╚══════════════════╝
}
{$F-} {$O-} {$A+} {$G-}
{$V-} {$B-} {$X-} {$N+} {$E+}
{$I FINAL.PAS}
{$IFDEF FINAL}
{$I-} {$R-}
{$D-} {$L-} {$S-}
{$ENDIF}
Unit PTUIVCRT;
Interface
Uses CRT,Strings;
Const
LMem_CRTPortBase = $463;
LMem_BufferLength= $44c;
LMem_NumberOfRows= $484;
LMem_NumberOfCols= $44a;
LMem_CurrentMode = $449;
LMem_BIOSFlags = $489;
MonoCard = 1;
ColorCard = 2;
Blink = 128;
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
LightGrey = 7;
DarkGray = 8;
DarkGrey = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
Type
MonoOrColor = MonoCard..ColorCard;
VideoScrollTypes = (ScrollAutoDetect, ScrollMethod1, ScrollMethod2,
ScrollMethod3);
VideoCardTypes = (MDA,CGA,EGA,VGA,SVGA,BWVGA,HerculesInColor);
VideoStateType = Record
FunctionalityInfo :Pointer;
VideoMode :Byte;
Columns :Word;
RegenBufferLength :Word;
RegenBufferAddr :Word;
CursorPos :Array[1..8,1..2] of Byte;
CursorType :Word;
ActivePage :Byte;
CRTControllerAddr :Word;
Register3x8 :Byte;
Register3x9 :Byte;
Rows :Byte;
CharacterHeight :Word;
DisplayCode :Byte;
DisplayCodeAlt :Byte;
ColoursSupport :Word;
TotalDisplayPages :Byte;
TotalScanLines :Byte;
PrimaryCharBlock :Byte;
SecondaryCharBlock:Byte;
StateInformation :Byte;
Reserved1 :Array[1..3] of Byte;
VideoMemory :Byte;
SavePointerState :Byte;
Reserved2 :Array[1..14] Of Byte;
End;
OneVideoCard = Record
XSize :Word;
YSize :Word;
SX1,SY1, {Screen}
SX2,SY2 :Word;
WX1,WY1,
WX2,WY2 :Word; {Window View Port}
Address :Word; {Screen Segment to Display}
CardType :VideoCardTypes;
CharacterHeight :Byte;
CharacterLength :Byte;
ScrollMethod :VideoScrollTypes;
End;
Var
VideoCard :Array [MonoCard..ColorCard] of OneVideoCard;
Card :MonoOrColor;
TextAttr :Byte; {Background, Forground}
LastMode :Byte;
Cursor :Boolean;
VX :Word;
VY :Word;
Function VideoWriteAddress(X1,Y1:Word):Pointer;
Procedure InitVideoCards;
Procedure SetVirtualScreen (XSize,YSize:Word);
Procedure ScreenOrigin (X,Y:Word);
Procedure PositionCursor;
Procedure GotoXY (X,Y:Word);
Function WhereX :Word;
Function WhereY :Word;
Procedure ClrScr;
Procedure ClrEOL;
Procedure DelLine;
Procedure InsLine;
Procedure TextMode (AL:Byte;BX,CX,DX:Word);
Procedure TextColor (Forg:Byte);
Procedure TextBackground (Backg:Byte);
Procedure VideoColor (Forg,Backg:Byte);
Procedure HighVideo;
Procedure LowVideo;
Function BackgroundColor :Byte;
Function ForgroundColor :Byte;
Procedure Window (X1,Y1,X2,Y2:Word);
Procedure WriteChr (Charac:Char);
Procedure WriteStr (Line:String);
Procedure WriteStrLn (Line:String);
Procedure ReadStr (X,Y:Word;MaxLets:Byte;Upper:Boolean;
Var MainStr:String);
Procedure EditStr (X,Y:Word;MaxLets:Byte;Upper:Boolean;
Var MainStr:String);
Procedure Pad (Count:Word;WithChar:Char);
Procedure Barometer (X,Y:Word;MaxLen:Byte;WithMe:Char;
Current,EndPoint:LongInt);
Procedure FillBlock (X1,Y1,X2,Y2:Word;WithChar:Char);
Function TextImageSize (X1,Y1,X2,Y2:Word):LongInt;
Procedure GetTextImage (X1,Y1,X2,Y2:Word;Data:Pointer);
Procedure PutTextImage (X1,Y1:Word;Data:Pointer);
Procedure WindowToVScreen (Var X1,Y1:Integer);
Procedure WindowToVScreen4 (Var X1,Y1,X2,Y2:Integer);
Procedure ScreenToVScreen (Var X1,Y1:Integer);
Procedure ScreenToVScreen4 (Var X1,Y1,X2,Y2:Integer);
Implementation
Function VideoWriteAddress(X1,Y1:Word):Pointer;
Begin
Inc(X1,VideoCard[Card].WX1 - 1);
Inc(Y1,VideoCard[Card].WY1 - 1);
VideoWriteAddress:=Ptr(VideoCard[Card].Address,
(((Y1-1)*VideoCard[Card].XSize*2)+((X1-1)*2)));
End;
Procedure InitVideoCards;
Begin
VideoCard[MonoCard].XSize :=80;
VideoCard[MonoCard].YSize :=25;
VideoCard[MonoCard].SX1 :=1;
VideoCard[MonoCard].SY1 :=1;
VideoCard[MonoCard].SX2 :=80;
VideoCard[MonoCard].SY2 :=25;
VideoCard[MonoCard].WX1 :=1;
VideoCard[MonoCard].WY1 :=1;
VideoCard[MonoCard].WX2 :=80;
VideoCard[MonoCard].WY2 :=25;
VideoCard[MonoCard].Address :=$B000;
VideoCard[MonoCard].CardType :=MDA;
VideoCard[MonoCard].CharacterHeight:=16;
VideoCard[MonoCard].CharacterLength:=8;
VideoCard[MonoCard].ScrollMethod :=ScrollAutoDetect;
VideoCard[ColorCard].XSize :=80;
VideoCard[ColorCard].YSize :=25;
VideoCard[ColorCard].SX1 :=1;
VideoCard[ColorCard].SY1 :=1;
VideoCard[ColorCard].SX2 :=80;
VideoCard[ColorCard].SY2 :=25;
VideoCard[ColorCard].WX1 :=1;
VideoCard[ColorCard].WY1 :=1;
VideoCard[ColorCard].WX2 :=80;
VideoCard[ColorCard].WY2 :=25;
VideoCard[ColorCard].Address :=$B800;
VideoCard[ColorCard].CardType :=CGA;
VideoCard[ColorCard].CharacterHeight:=16;
VideoCard[ColorCard].CharacterLength:=9;
VideoCard[ColorCard].ScrollMethod :=ScrollAutoDetect;
If MemW[$0:$0463] = $3B4 then
Card := MonoCard
Else
Card := ColorCard;
End;
Procedure SetVirtualScreen(XSize,YSize:Word);
Begin
VideoCard[ColorCard].XSize :=XSize;
VideoCard[ColorCard].YSize :=YSize;
VideoCard[ColorCard].SX1 :=1;
VideoCard[ColorCard].SY1 :=1;
VideoCard[ColorCard].WX1 :=1;
VideoCard[ColorCard].WY1 :=1;
VideoCard[ColorCard].WX2 :=XSize;
VideoCard[ColorCard].WY2 :=YSize;
Asm
xor ax, ax
mov es, ax
mov ax, XSize
mov es:[LMem_NumberOfCols], ax
mov cx, ax
mov bx, YSize
dec bx
mov es:[LMem_NumberOfRows], bl
inc bx
mul bl
shl ax, 1
mov es:[LMem_BufferLength], ax
shr cx, 1
mov ah, cl
mov al, 13h
mov dx, es:[LMem_CRTPortBase]
out dx, ax
End;
End;
Procedure ScreenOrigin(X,Y:Word);
Var
SX,
SY,
BytesPerRow :Word;
CharacterHeight :Byte;
CharacterLength :Byte;
ScrollMethod :VideoScrollTypes;
Label
UseAu